D 网络
B 广域网&WEB
007 在桌面上建立 Internet 快捷键 98-8-21
以下的代码可以在桌面上建立一个 Internet 快捷键。
Dim StrURLFile As String
Dim StrURLTarget As String
Dim FileNum As Integer
StrURLFile = "C:\Windows\Desktop\VB 加油站.url" '桌面目录和标题
StrURLTarget = "http://vbtt.yeah.net" '地址
FileNum = FreeFile
'Write the Internet Shortcut file
Open StrURLFile For Output As FileNum
Print #FileNum, "[InternetShortcut]"
Print #FileNum, "URL=" & StrURLTarget
Close FileNum
006 判断是否已经建立 Dial Up 连接 98-8-21
通过读取注册表， 可以知道该信息。
声明：
Public Const ERROR_SUCCESS = 0&
Public Const APINULL = 0&Public
Const HKEY_LOCAL_MACHINE = &H80000002
Public ReturnCode As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
函数：
Public Function ActiveConnection() As Boolean
Dim hKey As Long
Dim lpSubKey As String
Dim phkResult As Long
Dim lpValueName As String
Dim lpReserved As Long
Dim lpType As Long
Dim lpData As Long
Dim lpcbData As Long
ActiveConnection = False
lpSubKey = "System\CurrentControlSet\Services\RemoteAccess"
ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, _
phkResult)
If ReturnCode = ERROR_SUCCESS Then
hKey = phkResult
lpValueName = "Remote Connection"
lpReserved = APINULL
lpType = APINULL
lpData = APINULL
lpcbData = APINULL
ReturnCode = RegQueryValueEx(hKey, lpValueName, _
lpReserved, lpType, ByVal lpData, lpcbData)
lpcbData = Len(lpData)
ReturnCode = RegQueryValueEx(hKey, lpValueName, _
lpReserved, lpType, lpData, lpcbData)
If ReturnCode = ERROR_SUCCESS Then
If lpData = 0 Then
ActiveConnection = False
Else
ActiveConnection = True
End If
End If
RegCloseKey (hKey)
End If
End Function
005 断开与 Internet 的连接 98-7-20
声明：
Public Const RAS_MAXENTRYNAME As Integer = 256
Public Const RAS_MAXDEVICETYPE As Integer = 16
Public Const RAS_MAXDEVICENAME As Integer = 128
Public Const RAS_RASCONNSIZE As Integer = 412
Public Type RasEntryName
dwSize As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
End Type
Public Type RasConn
dwSize As Long
hRasConn As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
szDeviceType(RAS_MAXDEVICETYPE) As Byte
szDeviceName(RAS_MAXDEVICENAME) As Byte
End Type
Public Declare Function RasEnumConnections Lib _
"rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As _
Any, lpcb As Long, lpcConnections As Long) As Long
Public Declare Function RasHangUp Lib "rasapi32.dll" Alias _
"RasHangUpA" (ByVal hRasConn As Long) As Long
Public gstrISPName As String
Public ReturnCode As Long
函数：
Public Sub HangUp()
Dim i As Long
Dim lpRasConn(255) As RasConn
Dim lpcb As Long
Dim lpcConnections As Long
Dim hRasConn As Long
lpRasConn(0).dwSize = RAS_RASCONNSIZE
lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize
lpcConnections = 0
ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, _
lpcConnections)
If ReturnCode = ERROR_SUCCESS Then
For i = 0 To lpcConnections - 1
If Trim(ByteToString(lpRasConn(i).szEntryName)) _
= Trim(gstrISPName) Then
hRasConn = lpRasConn(i).hRasConn
ReturnCode = RasHangUp(ByVal hRasConn)
End If
Next i
End If
End Sub
Public Function ByteToString(bytString() As Byte) As String
Dim i As Integer
ByteToString = ""
i = 0
While bytString(i) = 0&
ByteToString = ByteToString & Chr(bytString(i))
i = i + 1
Wend
End Function
004 在程序中打开 Internet 拨号连接窗口 98-6-19
Private Sub StartConnection()
Dim X
X = Shell("rundll32.exe rnaui.dll,RnaDial " & "_连接的名称_", 1)
DoEvents
SendKeys "{enter}", True
DoEvents
End Sub
参见：JB004 不用 API ，直接调用关联的程序
003 打开浏览器并进入指定网址
声明：
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
例子：
Dim ret&
ret& = ShellExecute(Me.hwnd, "Open", "http://vbtt.yeah.net", "", App.Path, 1)
End Sub
也可以直接发送 Mail，只要把以上的 http 地址换为 "mailto:kenj@163.net"
002 在应用中集成浏览器
从 MS IE 3.0 开始就包括了一个名为 "WebBrowser" 的 ActiveX 控件。利用该控件，你可以开发强大的基于浏览器的应用。下面讨论如何进行集成。
1. 在 工程 菜单中, 选择 部件 。
2. 选择 Microsoft Internet Controls 。
3. 增加一个 WebBrowser 控件。
4. 使用以下的代码可连接到 VB 加油站:
WebBrowser1.Navigate "http://vbtt.yeah.net"
001 得到用户的IP地址
最快的方法是读取 Winsock 控件的 "LocalIP" 属性。
